home *** CD-ROM | disk | FTP | other *** search
/ Video Toaster 4.3 / Video Toaster v4.3.iso / 3.1 / toasterall / arexx_examples / tpaint / shrinkpic.rexx < prev    next >
OS/2 REXX Batch file  |  1992-01-29  |  4KB  |  105 lines
  1. /* ShrinkPic.rexx Shrink screen in ToasterPaint */
  2. /* By Arnie Cachelin © 1992 NewTek Inc. */
  3. /* Warning, stomps ruthlessly on your swap screen and swap brush! */
  4.  
  5. /*
  6.   This  program  will  shrink  a  given  picture  by a given amount.  If no
  7.   directory and picture name is given, it will shrink the current canvas to
  8.   1/4 it's size.
  9.  */
  10.  
  11. ARG Name factor                    /* Optional picture to load, and reduction amount */
  12.  
  13. if pos('DigiPaint',show(ports))=0 then do
  14.   say "Can't find ToasterPaint!"
  15.   exit
  16.   end
  17. Address "DigiPaint"     /* Tell ARexx where commands go  */
  18.  
  19. if factor="" then Rfactor=4   /*  reduction factor, size =1/rfactor, set this to 2,3,4... */
  20. else Rfactor=factor
  21. if name~="" then LoadRGB(name) /* if no name is given, we will shrink the current screen! */
  22.  
  23. w=752
  24. h=480
  25. w2=(w%RFactor) /* % means integer division... */
  26. h2=(h%RFactor)
  27.  
  28. 'Pmcl'                  /* Normal paint mode */
  29. 'Swap'                  /* jump to swap screen! */
  30. 'Cbx0'                                    /* Pick color zero to clear  */
  31. 'Clrs'                                    /* Clear screen  */
  32. 'Swap'                  /* jump to picture screen! */
  33. MapScreen(0,0,w2,h2)  /* Place resized screen on swap screen */
  34. CutBrush(0,0,w2,h2)   /* Cut resized brush */
  35. SaveBrush("ram:","tst")
  36. 'Bcop'                                    /* Copy brush to swap brush  */
  37. 'Swap'                  /* jump back to original screen */
  38. 'Pmcl'                                    /* Normal paint mode, TxMap off */
  39. exit
  40.  
  41. CutBrush: Procedure  /* Cut out a brush with corners at (x1,y1) and (x2,y2) */
  42.   arg x1, y1, x2, y2
  43.   'Dotb'        /* smallest brush size */
  44.   'Drre'        /* Rectangle mode  */
  45.   'Scis'        /* Scissors on, for cutting a brush  */
  46.   'Pend' x1 y1  /* Get in top Left corner  */
  47.   'Penu' x2 y2  /* lift pen to get brush!  */
  48.   return
  49.  
  50. MapScreen: Procedure  /* Size full screen into rectangle with corners at (x1,y1) and (x2,y2) */
  51.   arg x1, y1, x2, y2     /* rectangle is drawn on swap screen */
  52.   'Pmcl'        /* Normal draw Mode */
  53.   'Maxc'        /* Set center transparency off */
  54.   'Maxe'        /* Set edge transparency off */
  55.   'Flon'        /* Fill On */
  56.     'Bdel'                /* Delete swap brush */
  57.     'Dotb'                /* Delete any current cut-out brush */
  58.   'Drre'        /* Draw Rectangles */
  59.   'Swap'        /* Jump to (blank) swap screen! */
  60.   'Pend' x1 y1  /* Get in top Left corner  */
  61.   'Penu' x2 y2  /* Lift pen at bottom right */
  62.     'Undo'                /* Un-draw solid rectangle */
  63.     'Rubi'                /* Internal Rub-Thru on... use picture in swap screen as source */
  64.   'Aaon'        /* Anti-alias on */
  65.   'Txma'        /* Texture mapping on, since there is no brush, it will use whole screen */
  66.     'Redo'                /* Re-draw rectangle, this time with texture map of swap screen */
  67.   'Flof'        /* Fill off  */
  68.   'Pmcl'        /* Normal draw Mode */
  69.   return
  70.  
  71. LoadRGB: Procedure       /* Load Picture */
  72.   arg filename
  73.   'Lo24'                 /* Call file requester  */
  74.     Call SetFile(filename)
  75.   return
  76.  
  77. SaveBrush: PROCEDURE   /* Save Brush */
  78.   arg filename
  79.   'Sabr'                 /* Call file requester  */
  80.     Call SetFile(filename)
  81.   return
  82.  
  83.  
  84. SetFile: PROCEDURE           /* Select file in current requester */
  85.   arg file
  86.   dirname=GetPathName(file)
  87.   'Dnam'dirname          /* Enter file path  */
  88.   'Dsel'                 /* Hit return on directory */
  89.   filename=GetFileName(file)
  90.   'Fnam'filename         /* Enter File name  */
  91.   'Okls'                 /* Hit the OK button  */
  92.   return
  93.  
  94. GetFileName: procedure  /* Extract file name from full file specification */
  95.    ARG fullfile
  96.    c = lastpos("/",fullfile)
  97.    if c = 0 then c = lastpos(":",fullfile)
  98.    return substr(fullfile, c + 1)
  99.  
  100. GetPathName: procedure  /* Extract directory name from full file specification */
  101.    ARG fullfile
  102.    c = lastpos("/",fullfile)
  103.    if c = 0 then c = lastpos(":",fullfile)
  104.    return left(fullfile,c)
  105.